home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
007
/
qbsub10.arc
/
WINDOW.SUB
< prev
Wrap
Text File
|
1986-06-25
|
8KB
|
284 lines
'WINDOW.SUB -- MSDOS QuickBASIC Window handling subroutines 25 June 86
'| by David L. Poskie (608) 274-9560
'| 7118 Raymond Rd. Madison, WI 53719
'| These window-related subroutines were adapted from:
'| 'Software Construction Set for the IBM PC and PCjr', by Eric Anderson,
'| Hayden Book Company, 1984.
'| Please run any suggestions, corrections, additions, or changes by me.
'| I can be messaged on all the major Madison, WI RBBS's.
'| >>>> These routines do NOT save the underlying screen attributes when a
'| screen is saved. I'd appreciate a good modification to the Save &
'| Restore subroutines that would save attributes, and PEEK/POKE
'| directly to video RAM (&HB800 for color). Another good modification
'| would be a set of SCROLL subroutines to use in windows.
'| NOTE: You must have $Include: 'KEY.SUB' in your main program, and you must
'| have DIMensioned variables there or uncommented the next two DIM's.
'| >>>> These subroutines convert conventional Microsoft X = Row , Y = Column.
'| In here, X is the horizontal dimension and Y is the vertical.
' For clarity, I prefer moving these to the top of the main program.
'DIM HSelect$(10) , VSelect$(10) , SaveWindow$(100)
'DIM NowX(20) , NowY(20) , NowWidth(20) , HeightNow(20)
' Set a base count for the save/restore subroutines
NumLines = 1
'| Add window at (X , Y) of WWidth and WHeight
AddWindow:
' Add 2 chars for border
WWidth = WWidth + 2
WHeight = WHeight + 2
' Bump NowWindow ( NOW generally refers to the current window )
NowWindow = NowWindow + 1
' Transfer X , Y to NowX , NowY
NowX(NowWindow) = X
NowY(NowWindow) = Y
' Transfer width and height information
NowWidth(NowWindow) = WWidth
HeightNow(NowWindow) = WHeight
'| Save underlying information in window
'| at (X , Y) of WWidth and WHeight
SaveWindow:
FOR W.Y = Y TO Y + WHeight - 1
SaveWindow$(NumLines) = ""
' Copy each character to SaveWindow$() (Doesn't get attribute)
FOR W.X = X TO X + WWidth - 1
SaveWindow$(NumLines) = SaveWindow$(NumLines) + CHR$(SCREEN(W.Y , W.X))
NEXT W.X
NumLines = NumLines + 1
NEXT W.Y
'| Draw window at (X , Y) of WWidth and WHeight
'| If DoubleBox = TRUE, do a double-line box else do a single-line box
W.DRAW:
LOCATE Y , X
IF DoubleBox _
THEN PRINT CHR$(201); STRING$(WWidth - 2 , 205); CHR$(187); _
ELSE PRINT CHR$(218); STRING$(WWidth - 2 , 196); CHR$(191);
FOR W.Y = Y + 1 TO Y + WHeight - 2
LOCATE W.Y , X
IF DoubleBox _
THEN PRINT CHR$(186); SPC(WWidth - 2); CHR$(186); _
ELSE PRINT CHR$(179); SPC(WWidth - 2); CHR$(179);
NEXT W.Y
LOCATE Y + WHeight - 1 , X
IF DoubleBox _
THEN PRINT CHR$(200); STRING$(WWidth - 2 , 205); CHR$(188); _
ELSE PRINT CHR$(192); STRING$(WWidth - 2 , 196); CHR$(217);
RETURN
'| Remove window
KillWindow:
X = NowX(NowWindow) ' Let (X , Y) equal upper left
Y = NowY(NowWindow) ' of window to remove
WWidth = NowWidth(NowWindow) ' Window's width
WHeight = HeightNow(NowWindow) ' Window's height
NowWindow = NowWindow - 1 ' One less window now
GOSUB RestoreWindow ' Restore the text
RETURN
'| Restore text
RestoreWindow:
FOR W.Y = Y + WHeight - 1 TO Y STEP -1
LOCATE W.Y , X
NumLines = NumLines - 1
' If no window, restore original screen attributes,
' else use screen attributes of window
IF NowWindow = 0 _
THEN COLOR OldFG , OldBG , OldMG _
ELSE COLOR FG,BG,MG
PRINT SaveWindow$(NumLines)
NEXT W.Y
RETURN
'| Write Text$ at relative (X , Y) within window W
WriteWindow:
IF LEN(Text$) > (NowWidth(W) - 2) - X + 1 _
THEN Check = (NowWidth(W) - 2) - X + 1 _
ELSE Check = LEN(Text$)
LOCATE NowY(W) + Y , NowX(W) + X
PRINT LEFT$(Text$ , Check); ' If too big to fit
RETURN ' truncate the text
'| Write inverse Text$ at relative (X,Y) within window W
WriteInverseWindow:
IF LEN(Text$) > (NowWidth(W) - 2) - X + 1 _
THEN Check = (NowWidth(W) - 2) - X + 1 _
ELSE Check = LEN(Text$)
LOCATE NowY(W) + Y , NowX(W) + X
COLOR 14 , 2 , MG
PRINT LEFT$(Text$ , Check);
COLOR 10 , 0 , MG
RETURN
'| Go to X , Y within the window, W
WGoToXY:
LOCATE NowY(W) + Y , NowX(W) + X
RETURN
' This is the end of the window subroutines.
' Next come the window menu subroutines.
'| Horizontal menu selection
'| Inputs to this routine
'| W Which window to display the menu within
'| HSelect$() The text of each menu selection
'| HNumSelects How many selections are in the menu
'| HSelectWidth How many columns each menu item gets
'| NewWindow If TRUE, create the window, else
'| use the window specified by W
'| Returns:
'| SelectNum The # of menu selection chosen.
'| Set the parameters to create a 1 line window for the menu.
HMenu:
X = NowX(W)
Y = NowY(W)
WWidth = NowWidth(W) - 2
WHeight = 1
IF NewWindow _
THEN GOSUB AddWindow : _
W = NowWindow
X = 1
Y = 1
' Clear out the current line
Text$ = SPACE$(WWidth)
GOSUB WriteWindow
' Now display the selections
FOR W.Y = 1 TO HNumSelects
Text$ = HSelect$(W.Y)
COLOR 10 , 0 , 8
GOSUB WriteWindow
X = X + HSelectWidth
NEXT W.Y
X = 1
SelectNum = 1
DisplayHMenu:
Text$ = HSelect$(SelectNum)
GOSUB WriteInverseWindow
HMenuGetKey:
GOSUB GetKeyCode ' Get an input character
' Return if <CR> pressed
IF KeyCode = 13 _
THEN RETURN
' If not left or right, get another
IF KeyCode <> 75 _
AND KeyCode <> 77 _
THEN GOTO HMenuGetKey
' Change current selection back to normal display
Text$ = HSelect$(SelectNum)
GOSUB WriteWindow
'| If left arrow and at far left, wrap around & go.
IF KeyCode = 75 _
AND SelectNum = 1 _
THEN X = X + (HSelectWidth * (HNumSelects - 1)) : _
SelectNum = HNumSelects : _
GOTO DisplayHMenu
'| If left arrow, then move to previous menu selection
IF KeyCode = 75 _
AND SelectNum > 1 _
THEN X = X - HSelectWidth : _
SelectNum = SelectNum - 1
'| If right arrow and at far right, wrap around & go.
IF KeyCode = 77 _
AND SelectNum = HNumSelects _
THEN X = X - (HSelectWidth * (HNumSelects - 1)) : _
SelectNum = 1 : _
GOTO DisplayHMenu
'| If right arrow then move to next menu selection
IF KeyCode = 77 _
AND SelectNum < HNumSelects _
THEN X = X + HSelectWidth : _
SelectNum = SelectNum + 1
GOTO DisplayHMenu
'| Vertical pull-down menu subroutine
'| Input:
'| W The # of the window holding the horizontal menu
'| SelectNum The item selected on the horizontal menu
'| HSelectWidth The # of columns for each item in that menu
'| VSelect$() A list of each menu item to appear
'| VNumSelects The # of selections in the pull down menu
'| VSelectWidth How wide the pull-down menu should be
'| Returns:
'| SelectNum The # of the chosen menu selection
'| Display one line window for menu
VMenu:
Y = NowY(W) + 2
X = NowX(W) + (SelectNum - 1) * HSelectWidth
WWidth = VSelectWidth
WHeight = VNumSelects
' Draw the tiny window
GOSUB AddWindow
X = 1
Y = 1
W = NowWindow
FOR W.Y = 1 TO VNumSelects
Text$ = VSelect$(W.Y)
GOSUB WriteWindow
Y = Y + 1
NEXT W.Y
X = 1
Y = 1
SelectNum = 1
ShowVMenu:
Text$ = VSelect$(SelectNum)
GOSUB WriteInverseWindow
VMenuGetKey:
GOSUB GetKeyCode
IF KeyCode = 13 _
THEN RETURN
IF KeyCode <> 72 _
AND KeyCode <> 80 _
THEN GOTO VMenuGetKey
Text$ = VSelect$(SelectNum)
GOSUB WriteWindow
IF KeyCode = 72 _
AND SelectNum > 1 _
THEN Y = Y - 1 : _
SelectNum = SelectNum - 1
IF KeyCode = 80 _
AND SelectNum < VNumSelects _
THEN Y = Y + 1 : _
SelectNum = SelectNum + 1
GOTO ShowVMenu
'| >>>>> Physical EOF WINDOW.SUB 25 June 86